Visual Basic Controls/Visual Basic Controls.iso/vbcontrol/edgetext/clsemplo.cl_/clsemplo.cl

Text File | 1998-03-21 | 52.7 KB | 1,414 lines

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
End
Attribute VB_Name = "clsEmployee"
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
'**************************************************************************************
'Title:     clsEmployee.cls
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This class allows single record access to the Employee Table
'Properties:Equate to the fields in the table
'Methods:   Allow for record manipulation


'It is recommended that the Database object Dbtimesheet be declared global

'It is also recommended that the Configuration object be declared global if it is being used
'This is so that it can be persistent
'**************************************************************************************

'Here are the Field Properties for this table Class
Public Employee_Id as Long
Public Employee_Name as String
Public Employee_SS as String
Public Updated_By as String
Public Update_Module as String
Public Update_Time as String

'These are the ScratchPad Variables
Private mEmployee_Id as Long
Private mEmployee_Name as String
Private mEmployee_SS as String
Private mUpdated_By as String
Private mUpdate_Module as String
Private mUpdate_Time as String

'This public variable tells whether a function was successful, it is True when a function
'is successful, and false when a function is unsuccessful
Public Success as Boolean
'This is the Error Code which was generated in the function call, it matches Err from VB
Public ErrorCode as Double
'This is the Error message which was generated in the function call, it matches Errors(0) VB
Public ErrorMessage as String
'This Constant tells the error traps how many retries to perform
Private Const MaxRetries = 4

'********************************************************************************************************
'Title:     CreateTable
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This subroutine Creates the very table that this class was created to read and write
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Public Sub CreateTable()

Dim lsCreate as string
Dim RetCode as integer, liCount as integer, BadCount as integer

    'The Success flag gets initialized to True and set to false if a trappable error occurs
    Success = True
    'The ErrorCode is the Err returned by VB for the Trapped Error
    ErrorCode = False
    'The DebugFlag is the provision which turns off all error checking in the table class when false
    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoEmployeeCreateTable
    End If


    'Assemble the SQL String
    lsCreate = "Create Table EMPLOYEE ("
    lsCreate = lsCreate & "Employee_Id Long(4),"
    lsCreate = lsCreate & "Employee_Name String(100),"
    lsCreate = lsCreate & "Employee_SS String(11),"
    lsCreate = lsCreate & "Updated_By String(50),"
    lsCreate = lsCreate & "Update_Module String(50),"
    lsCreate = lsCreate & "Update_Time Date/Time(8))"

    'Execute the SQL
    Dbtimesheet.Execute lsCreate
    On Error GoTo 0
    Exit Sub

NoEmployeeCreateTable:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadEmployeeCreateTableConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsEmployee.CreateTable"
        If Err = 3146 then
            objError.Message = "Employee, CreateTable " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Employee, CreateTable "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = lsCreate
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadEmployeeCreateTableConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub


'********************************************************************************************************
'Title:     AddItem
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This method Adds Items to the Database after the Key properties
'           of the class have been filled
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Public Sub AddItem()

Dim lsAdd as string
Dim RetCode as integer, liCount as integer, BadCount as integer

    'The Success flag gets initialized to True and set to false if a trappable error occurs
    Success = True
    'The ErrorCode is the Err returned by VB for the Trapped Error
    ErrorCode = False
    'The DebugFlag is the provision which turns off all error checking in the table class when false
    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoEmployeeAddItem
    End If

    'First we assign all the properties to temp vars and set any blank dates to NULL, or put in the date delimiters (Database Dependent)
    StoreProperties
    SetDefaultDates

    'Now Pad fields with a space if the record cannot be added with zero length
    PadFields

    'The Double Your Quotes routine doubles any single quotes in string type variables for SQL compatibility
    DoubleYourQuotes

    'Assemble the SQL String
    lsAdd = "Insert into EMPLOYEE ("
    'First the Field List
    lsAdd = lsAdd & "Employee_Id,"
    lsAdd = lsAdd & "Employee_Name,"
    lsAdd = lsAdd & "Employee_SS,"
    lsAdd = lsAdd & "Updated_By,"
    lsAdd = lsAdd & "Update_Module,"
    lsAdd = lsAdd & "Update_Time)"
    lsAdd = lsAdd & " Values("
    'Now the Value List
    lsAdd = lsAdd & "" & Format(Employee_Id) & ","
    lsAdd = lsAdd & "'" & Employee_Name & "',"
    lsAdd = lsAdd & "'" & Employee_SS & "',"
    'These are the Audit Trail Fields
    lsAdd = lsAdd & "'" & objConfiguration.LanId & "',"
    lsAdd = lsAdd & "'" & objConfiguration.ModuleName & "',"
    lsAdd = lsAdd & "#" & format(Now,"MM/DD/YYYY hh:mm:ss") & "#)"

    'Execute the SQL
    Dbtimesheet.Execute lsAdd

    'Reassign the original values to the properties list
    RetrieveProperties

    On Error GoTo 0
    Exit Sub

NoEmployeeAddItem:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadEmployeeAddItemConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsEmployee.AddItem"
        If Err = 3146 then
            objError.Message = "Employee, AddItem " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Employee, AddItem "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = lsAdd
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadEmployeeAddItemConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub

'********************************************************************************************************
'Title:     ClearValues
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This method clears all fields in the Table class
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Sub ClearValues()

    Employee_Id = 0
    Employee_Name = ""
    Employee_SS = ""
    Updated_By = ""
    Update_Module = ""
    Update_Time = ""

End Sub


'********************************************************************************************************
'Title:     DeleteItem
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This method Deletes Items from the Database after the Key fields have been filled
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Public Sub DeleteItem()

Dim lrsEmployee as RecordSet, lsDelete as string
Dim RetCode as integer,lsCount as integer,liCount as integer,BadCount as integer

    'The Success flag gets initialized to True and set to false if a trappable error occurs
    Success = True
    'The ErrorCode is the Err returned by VB for the Trapped Error
    ErrorCode = False
    'The DebugFlag is the provision which turns off all error checking in the table class when false
    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoEmployeeDeleteItem
    End If

    'First we assign all the properties to temp vars and set any blank dates to NULL, or put in the date delimiters (Database Dependent)
    StoreProperties
    SetDefaultDates

    'Now Pad fields with a space if the record cannot be added with zero length
    PadFields

    'The Double Your Quotes routine doubles any single quotes in string type variables for SQL compatibility
    DoubleYourQuotes

    'Assemble the SQL String
    lsDelete = "Delete from EMPLOYEE  where Employee_Id = " & Format(Employee_Id) & ""

    'Execute the SQL
     Dbtimesheet.Execute lsDelete

    'Now ReAssign the Temp vars back to the class props
    RetrieveProperties

    On Error GoTo 0
    Exit Sub

NoEmployeeDeleteItem:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadEmployeeDeleteItemConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsEmployee.DeleteItem"
        If Err = 3146 then
            objError.Message = "Employee, DeleteItem " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Employee, DeleteItem "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = lsDelete
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadEmployeeDeleteItemConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub


'********************************************************************************************************
'Title:     FillObjectFromRecordset
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose    This sub fills all the properties of the class from a given recordset
'Parameters:The recordset from which to fill
'Return:    Nothing
'********************************************************************************************************
Public Sub FillObjectFromRecordSet(lrsEmployee as RecordSet)

Dim liCount as Integer, BadCount as Integer, pSQL as String, lsSelect as String
    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoEmployeeFillObject
    End If

    'Appending a & "" onto the end of a recordset field checks for Null values
    'Similarly, Numbers are explicitly converted to eliminate Null values as well
    Employee_Id = Val(lrsEmployee![Employee_Id] & "")
    Employee_Name = lrsEmployee![Employee_Name] & ""
    Employee_SS = lrsEmployee![Employee_SS] & ""
    Updated_By = lrsEmployee![Updated_By] & ""
    Update_Module = lrsEmployee![Update_Module] & ""
    Update_Time = lrsEmployee![Update_Time] & ""
    On Error GoTo 0
    Exit Sub

NoEmployeeFillObject:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadEmployeeFillObjectConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsEmployee.FillObject"
        If Err = 3146 then
            objError.Message = "Employee, FillObject " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Employee, FillObject "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = lsSelect
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadEmployeeFillObjectConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub


'********************************************************************************************************
'Title:     GetItem
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This Method Gets a record from the database after the Key Fields have been Filled
'Parameters:The recordset from which to fill
'Return:    Nothing
'********************************************************************************************************
Public Sub GetItem()

Dim lrsGetItem as RecordSet, lsSelect as string
Dim RetCode as integer,lsCount as integer,liCount as integer,BadCount as integer

    'The Success flag gets initialized to True and set to false if a trappable error occurs
    Success = True
    'The ErrorCode is the Err returned by VB for the Trapped Error
    ErrorCode = False
    'The DebugFlag is the provision which turns off all error checking in the table class when false
    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoEmployeeGetItem
    End If

    'First we assign all the properties to temp vars and set any blank dates to NULL, or put in the date delimiters (Database Dependent)
    StoreProperties
    SetDefaultDates

    'Now Pad fields with a space if the record cannot be added with zero length
    PadFields

    'The Double Your Quotes routine doubles any single quotes in string type variables for SQL compatibility
    DoubleYourQuotes

    'Assemble the SQL String
    lsSelect = "Select * from EMPLOYEE  where Employee_Id = " & Format(Employee_Id) & ""

    'Execute the SQL
     Set lrsGetItem = Dbtimesheet.OpenRecordSet(lsSelect)

    'Now ReAssign the Temp vars back to the class props
    RetrieveProperties

    'Check for a valid record
    If Not Success Then
        Exit Sub
    End If
    If lrsGetItem.RecordCount = 0 Then
        Success = False
        Exit Sub
    End If

    'Fill the Table Class Fields from the Recordset
    FillObjectFromRecordset lrsGetItem
    'Check for Errors
    if not Success then
        Exit sub
    end if
    lrsGetItem.Close

    'Now trim the spaces out of the padded fields
    TrimPaddedFields

    'Strip the NULLs or bad dates out of date fields
    StripDates False

    On Error GoTo 0
    Exit Sub

NoEmployeeGetItem:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadEmployeeGetItemConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsEmployee.GetItem"
        If Err = 3146 then
            objError.Message = "Employee, GetItem " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Employee, GetItem "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = lsSelect
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadEmployeeGetItemConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub


'********************************************************************************************************
'Title:     GetNewId
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This Method Gets a new Id using the Max function in SQL, it has only limited value, but is included as
'           a template for new Primary Key generation
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Public function GetNewId() as double

Dim lrsGetNewId as RecordSet, lsSelect as string
Dim RetCode as integer,liCount as integer,BadCount as integer

    'The Success flag gets initialized to True and set to false if a trappable error occurs
    Success = True
    'The ErrorCode is the Err returned by VB for the Trapped Error
    ErrorCode = False
    'The DebugFlag is the provision which turns off all error checking in the table class when false
    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoEmployeeGetNewId
    End If

    'First we assign all the date and text properties to temp vars and set any blank dates to NULL, or put in the date delimiters (Database Dependent)
    StoreProperties
    SetDefaultDates

    'Now Pad fields with a space if the record cannot be added with zero length
    PadFields

    'The Double Your Quotes routine doubles any single quotes in string type variables for SQL compatibility
    DoubleYourQuotes


    'The SQL provided here is just a simple Get Max.  This would only be useful for very small tables
    'If you anticipate this table growing past a few hundred rows, change this routine accordingly
    'You might try keeping a table with the last Id stored as a field, which can then be updated when a
    'new Id is required.

    'Assemble the SQL String
    lsSelect = "Select Max(Employee_Id) from EMPLOYEE

    'Execute the SQL
    Set lrsGetNewId = Dbtimesheet.OpenRecordSet(lsSelect)

    'Now ReAssign the Temp vars back to the class props
    RetrieveProperties

    'Don't forget to check for those NULLS
    If Not IsNull(lrsGetNewId(0)) Then
        GetNewId = lrsGetNewId(0) + 1
    Else
        GetNewId = 1
    End If
    lrsGetNewId.Close
    On Error GoTo 0
    Exit Function

NoEmployeeGetNewId:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadEmployeeGetNewIdConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsEmployee.GetNewId"
        If Err = 3146 then
            objError.Message = "Employee, GetNewId " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Employee, GetNewId "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = lsSelect
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadEmployeeGetNewIdConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Function


'********************************************************************************************************
'Title:     ParseItem
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This method can parse fields which have values in them.  It will create an SQL criteria string
'           using like statements for strings, and = statements for numbers and dates, this can be used
'           in Query by Example screens with little or no modification
'Parameters:None
'Return:    The Parsed String for use in SQL
'********************************************************************************************************
Public Function ParseItem(piAndFlag as Integer) As String

Dim RetCode as integer,liCount as integer,Buf1 as String
Dim BadCount as integer, WildCard As String

    'The Success flag gets initialized to True and set to false if a trappable error occurs
    Success = True
    'The ErrorCode is the Err returned by VB for the Trapped Error
    ErrorCode = False
    'The DebugFlag is the provision which turns off all error checking in the table class when false
    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoEmployeeParseItem
    End If

    'Change this based on your database, MS-Access uses the *, but SQL standard is the %
    wildcard = "*'"

    'First we assign all the date and text properties to temp vars and set any blank dates to NULL, or put in the date delimiters (Database Dependent)
    StoreProperties
    SetDefaultDates

    'Now Pad fields with a space if the record cannot be added with zero length
    PadFields
    'The Double Your Quotes routine doubles any single quotes in string type variables for SQL compatibility
    DoubleYourQuotes


    If Employee_Id <> 0 Then
        If piAndFlag Then
            Buf1 = Buf1 & " And "
        Else
            Buf1 = Buf1 & " Where "
        End If
        Buf1 = Buf1 & "Employee.Employee_Id = " & Format(Employee_Id)
        piAndFlag = True
    End If

    If Trim(Employee_Name) <> "" Then
        If piAndFlag Then
            Buf1 = Buf1 & " And "
        Else
            Buf1 = Buf1 & " Where "
        End If
        Buf1 = Buf1 & "Employee.Employee_Name like '" & Trim(Employee_Name) & WildCard
        piAndFlag = True
    End If

    If Trim(Employee_SS) <> "" Then
        If piAndFlag Then
            Buf1 = Buf1 & " And "
        Else
            Buf1 = Buf1 & " Where "
        End If
        Buf1 = Buf1 & "Employee.Employee_SS like '" & Trim(Employee_SS) & WildCard
        piAndFlag = True
    End If

    If Trim(Updated_By) <> "" Then
        If piAndFlag Then
            Buf1 = Buf1 & " And "
        Else
            Buf1 = Buf1 & " Where "
        End If
        Buf1 = Buf1 & "Employee.Updated_By like '" & Trim(Updated_By) & WildCard
        piAndFlag = True
    End If

    If Trim(Update_Module) <> "" Then
        If piAndFlag Then
            Buf1 = Buf1 & " And "
        Else
            Buf1 = Buf1 & " Where "
        End If
        Buf1 = Buf1 & "Employee.Update_Module like '" & Trim(Update_Module) & WildCard
        piAndFlag = True
    End If

    if isDate(Update_Time) then
        If piAndFlag Then
            Buf1 = Buf1 & " And "
        Else
            Buf1 = Buf1 & " Where "
        End If
        Buf1 = Buf1 & "Employee.Update_Time = " & Update_Time
        piAndFlag = True
    End If

    'now reassign the temp values back to the properties
    RetrieveProperties

    On Error GoTo 0
    ParseItem = Buf1
    Exit Function

NoEmployeeParseItem:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadEmployeeParseItemConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsEmployee.ParseItem"
        If Err = 3146 then
            objError.Message = "Employee, ParseItem " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Employee, ParseItem "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = Buf1
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadEmployeeParseItemConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Function


'********************************************************************************************************
'Title:     UpdateItem
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This method updates a record in the database using the primary key, it is recommended that you
'           Fill the Key Fields, use the get method, fill the fields which have changed,
'           then call this method to perform the update
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Public Sub UpdateItem()

Dim lsUpdate as string
Dim RetCode as integer, liCount as integer, BadCount as integer

    'The Success flag gets initialized to True and set to false if a trappable error occurs
    Success = True
    'The ErrorCode is the Err returned by VB for the Trapped Error
    ErrorCode = False
    'The DebugFlag is the provision which turns off all error checking in the table class when false
    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoEmployeeUpdateItem
    End If

    'First we will assign the date properties to temp vars and set any blank dates to NULL, or put in the date delimiters (Database Dependent)
    StoreProperties
    SetDefaultDates

    'Now Pad fields with a space if the record cannot be added with zero length
    PadFields

    'The Double Your Quotes routine doubles any single quotes in string type variables for SQL compatibility
    DoubleYourQuotes

    'Assemble the SQL String
    lsUpdate = "Update EMPLOYEE Set "
    lsUpdate = lsUpdate & "Employee_Name = '" & Employee_Name & "',"
    lsUpdate = lsUpdate & "Employee_SS = '" & Employee_SS & "',"
    'These are the Audit Trail Fields
    lsUpdate = lsUpdate & "Updated_By = '" & objConfiguration.LanId & "',"
    lsUpdate = lsUpdate & "Update_Module = '" & objConfiguration.ModuleName & "',"
    lsUpdate = lsUpdate & "Update_Time = #" & format(Now,"MM/DD/YYYY hh:mm:ss") & "# "
    lsUpdate = lsUpdate & " where Employee_Id = " & Format(Employee_Id) & ""

    'Execute the SQL
    Dbtimesheet.Execute lsUpdate

    'now reassign the temp values back to the properties
    RetrieveProperties

    On Error GoTo 0
    Exit Sub

NoEmployeeUpdateItem:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadEmployeeUpdateItemConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsEmployee.UpdateItem"
        If Err = 3146 then
            objError.Message = "Employee, UpdateItem " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Employee, UpdateItem "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = lsUpdate
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadEmployeeUpdateItemConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub

'********************************************************************************************************
'Title:     DoubleYourQuotes
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This routine Doubles your Single Quotes in all string or memo
'           fields in the class for SQL compatibility
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Private Sub DoubleYourQuotes()

Dim liCount as integer,BadCount as integer

    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoEmployeeDoubleYourQuotes
    End If

    'These lines double the single quotes in any string field in the class
    Employee_Name = SearchandDouble(Employee_Name)
    Employee_SS = SearchandDouble(Employee_SS)
    Updated_By = SearchandDouble(Updated_By)
    Update_Module = SearchandDouble(Update_Module)
    On Error GoTo 0
    Exit Sub

NoEmployeeDoubleYourQuotes:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadEmployeeDoubleYourQuotesConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsEmployee.DoubleYourQuotes"
        If Err = 3146 then
            objError.Message = "Employee, DoubleYourQuotes " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Employee, DoubleYourQuotes "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = ""
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadEmployeeDoubleYourQuotesConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub

'********************************************************************************************************
'Title:     SearchandDouble
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This Function will look for any single quotes in a string passed to it
'           and double them for SQL compatibility
'Parameters:string to be modified
'Return:    the modified string
'********************************************************************************************************
Private Function SearchandDouble(lsBuf As String) As String

Dim liStrLen As Integer
Dim liCurChar As Integer
Dim liQuotePos As Integer
Dim lsQuote As String
Dim lsOutBuf As String

    lsQuote = "'"
    liCurChar = 1
    lsOutBuf = ""


    liQuotePos = InStr(liCurChar, lsBuf, lsQuote)
    If liQuotePos = 0 Then
        lsOutBuf = lsBuf
    Else
        liStrLen = Len(lsBuf)
        Do While liQuotePos > 0
            lsOutBuf = lsOutBuf & Mid(lsBuf, liCurChar, liQuotePos - liCurChar + 1) & lsQuote
            liCurChar = liQuotePos + 1
            liQuotePos = InStr(liCurChar, lsBuf, lsQuote)
        Loop
        lsOutBuf = lsOutBuf & Mid(lsBuf, liCurChar, liStrLen)
    End If

    SearchandDouble = lsOutBuf

End Function

'********************************************************************************************************
'Title:     SetDefaultDates
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This routine puts default date or NULL into blank or invalid date fields
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Private Sub SetDefaultDates()

Dim liCount as integer,BadCount as integer

    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoEmployeeSetDefaultDates
    End If

    'These lines look at the dates in the class, and put a NULL or your default date
     'depending on your data mode, when the date is
    'blank or invalid, since this is what sql expects
    if not isDate(Update_Time) then
        Update_Time = "NULL"
    Else
        Update_Time = "#" & format(CDate(Update_Time),"MM/DD/YYYY HH:MM:SS") & "#"
    Endif
    On Error GoTo 0
    Exit Sub

NoEmployeeSetDefaultDates:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadEmployeeSetDefaultDatesConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsEmployee.SetDefaultDates"
        If Err = 3146 then
            objError.Message = "Employee, SetDefaultDates " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Employee, SetDefaultDates "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = ""
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadEmployeeSetDefaultDatesConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub

'********************************************************************************************************
'Title:     StripDates
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This routine strips NULLS and bad Dates from Fields in the class, the delimiter field
'           determines whether it should check for the presence of Date Delimiters
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Private Sub StripDates(DelimiterFlag as integer)

Dim liCount as integer,BadCount as integer

    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoEmployeeStripDates
    End If

    'These lines check to see if a NULL has been entered into the field from the
    'DefaultDate subroutine, if it has, it is set to an empty string, the date from
    'the database is also checked, if it is invalid, it to is set to an empty string
    if Update_Time = "NULL" then
        Update_Time = ""
    Endif
    On Error GoTo 0
    Exit Sub

NoEmployeeStripDates:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadEmployeeStripDatesConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsEmployee.StripDates"
        If Err = 3146 then
            objError.Message = "Employee, StripDates " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Employee, StripDates "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = ""
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadEmployeeStripDatesConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub

'********************************************************************************************************
'Title:     PadFields
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This routine Pads any fields with a space which do not allow zero length
'Purpose:   The Allow zero length property is set by default in Access databases and is
'           used also in Oracle and SQLServer if the if fields are not padded with space
'           the database won't add the record, sometimes this is desirable sometimes not
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Private Sub PadFields()

Dim liCount as integer,BadCount as integer

    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoEmployeePadFields
    End If

    'These lines put a space into any field which does not allow zero length, so the
    'record can be added anyway
    if Trim(Employee_Name) = "" then
            Employee_Name = " "
    Endif
    if Trim(Employee_SS) = "" then
            Employee_SS = " "
    Endif
    if Trim(Updated_By) = "" then
            Updated_By = " "
    Endif
    if Trim(Update_Module) = "" then
            Update_Module = " "
    Endif
    On Error GoTo 0
    Exit Sub

NoEmployeePadFields:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadEmployeePadFieldsConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsEmployee.PadFields"
        If Err = 3146 then
            objError.Message = "Employee, PadFields " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Employee, PadFields "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = ""
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadEmployeePadFieldsConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub

'********************************************************************************************************
'Title:     TrimPaddedFields
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose:   This routine Trims the fields which have spaces at beginning or end
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Private Sub TrimPaddedFields()

Dim liCount as integer,BadCount as integer

    If Not objConfiguration.DebugFlag Then
        On Error GoTo NoEmployeeTrimPaddedFields
    End If

    'This routine deletes the spaces from any padded fields
    Employee_Name = Trim(Employee_Name)
    Employee_SS = Trim(Employee_SS)
    Updated_By = Trim(Updated_By)
    Update_Module = Trim(Update_Module)
    On Error GoTo 0
    Exit Sub

NoEmployeeTrimPaddedFields:

    'Retry for a predermined number of times, set by the MaxRetries Constant
    If BadCount < MaxRetries Then
        'if we have been exceeded retries on a previous error in this routine,
        'just give the remaining errors one try, and don't save these errors,
        'the interest should be in the original error
        If Success = False Then
            Resume Next
        Else
            'increment the retry counter
            BadCount = BadCount + 1
            'Look for Database errors and see if you can fix the error by reconnecting
            If Err = 3146 or Err = 3075 then
                'Try Reconnecting to the database, then
                'keep executing the same line of code in a hope that retries will
                'be the solution to the problem.
                On Error GoTo BadEmployeeTrimPaddedFieldsConnect
                Set Dbtimesheet = OpenDatabase(Objconfiguration.datasource)
                On Error goto 0
            End If
            Resume 0
        End If
    Else
        'At MaxRetries, flag a failure in the routine
        Success = False
        'set the ErrorCode and ErrorMessage Properties so the programmer can
        'get a reason why the error occurred
        ErrorCode = Err
        objError.ErrorCode = Err
        objError.FunctionName = "clsEmployee.TrimPaddedFields"
        If Err = 3146 then
            objError.Message = "Employee, TrimPaddedFields " & vbcrlf & Errors(0) & " "
            ErrorMessage = Errors(0)
        Else
            objError.Message = "Employee, TrimPaddedFields "
            ErrorMessage = Error(Err)
        End If
        objError.SQL = ""
        objError.Display vbExclamation
        'reset the counter
        BadCount = 0
        'and try to execute the next line of code in the routine
        Resume Next
    End If

BadEmployeeTrimPaddedFieldsConnect:
    'You can put additional database reopening error checking here if necessary
    Resume Next


End Sub


'********************************************************************************************************
'Title:     StoreProperties
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose    This Sub Assigns the Properties of the Class to the
'           private class scratchpad variables
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Private Sub StoreProperties()

    mEmployee_Id = Employee_Id
    mEmployee_Name = Employee_Name
    mEmployee_SS = Employee_SS
    mUpdated_By = Updated_By
    mUpdate_Module = Update_Module
    mUpdate_Time = Update_Time

End Sub

'********************************************************************************************************
'Title:     RetrieveProperties
'Author:    DesignGrid by W. David Ewing, Copyright 1998
'Purpose    This Sub Assigns the ScratchPad Variable Values back to the Class properties
'Parameters:None
'Return:    Nothing
'********************************************************************************************************
Private Sub RetrieveProperties()

    Employee_Id = mEmployee_Id
    Employee_Name = mEmployee_Name
    Employee_SS = mEmployee_SS
    Updated_By = mUpdated_By
    Update_Module = mUpdate_Module
    Update_Time = mUpdate_Time

End Sub